Option Explicit
Sub Q_Sample016()
    'ոQ_Data01
    ']wޥζMicrosoft Scripting Runtime
    Dim myDic As Scripting.Dictionary
    Dim myRng As Range
    Dim myMnb As Variant
    Set myDic = CreateObject("Scripting.Dictionary")
    'wƽd
    For Each myRng In Worksheets("Q_Data01").Range("a1") _
        .CurrentRegion.Columns(3).Offset(1).Cells
        With myRng
            If Len(.Text) > 0 Then
                myDic.Add Key:=myRng.Value, Item:=myRng.Offset(, 5).Value
            End If
        End With
    Next
    For Each myMnb In myDic.Keys
        Debug.Print myMnb, myDic(myMnb)
    Next
    Set myDic = Nothing                                 '
End Sub
